home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: MegaDisc
/
MegaDisc 27 (1992-03)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).zip
/
MegaDisc 27 (1992-03)(MegaDisc Digital Publishing)(AU)(Disk 2 of 2).adf
/
Programming
/
Basic_Routines
/
BasicSubs
/
demos
/
MenuMaker.demo
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1992-03-30
|
3KB
|
111 lines
FOR i = 1 TO 4: MENU i,0,0,"":NEXT i
CLEAR
SCREEN 1,640,250,3,2
WINDOW 2," MENUMAKER DEMO",,0,1
DIM choice$(16)
GOSUB LOADCOLOURS
GOSUB MENUDEMO1
SYSTEM
LOADCOLOURS:
OPEN "BasicUtils&Subs:SetupFiles/Colours" FOR INPUT AS #1
FOR i = 0 TO 7
INPUT #1,a,b,c,c$
PALETTE i,a,b,c
NEXT i
CLOSE
RETURN
MENUDEMO1:
choicenum%=4
choice$(1)="Create a new menu in PURPLE & YELLOW."
choice$(2)="Clear the screen to RED for 5 seconds."
choice$(3)="AMIGA talks!"
choice$(4)="Finish Demo."
olcol=4:bgcol=5:COLOR ,0
GOSUB MENUMAKER
IF opt%=4 THEN RETURN
ON opt% GOSUB SUB1,SUB2,SUB3: GOTO MENUDEMO1
SUB1:
choicenum%=3
choice$(1)="All choices on this demo menu"
choice$(2)="Take you back to the main menu."
choice$(3)="Press 'A', 'B' or 'C'"
olcol=7:bgcol=6:COLOR ,0
GOSUB MENUMAKER
RETURN
SUB2:
COLOR ,2
CLS
settime=0
ON TIMER (5) GOSUB TENSECS
TIMER ON
WHILE settime=0
WEND
RETURN
TENSECS:
settime=1
RETURN
SUB3:
talk$="Hello, my name is Amiga."
SAY TRANSLATE$(talk$)
RETURN
MENUMAKER:
CLS
choice$(0)= " THE FOLLOWING OPTIONS ARE AVAILABLE: "
COLOR olcol,bgcol
linelen=LEN(choice$(1))
FOR i = 2 TO choicenum%
IF LEN(choice$(i)) > linelen THEN linelen = LEN(choice$(i))
NEXT i
linelen = linelen +3:IF linelen < LEN(choice$(0)) THEN linelen = LEN(choice$(0))
linest= 40-INT(linelen/2)
xs =(linest*8)-5:ys=5
xe=((linelen+linest)*8)+19:ye=((5+choicenum%)*8)+3
GOSUB RAISED
LOCATE 2,21
PRINT choice$(0)
FOR i = 1 TO choicenum%
LOCATE 3+i,linest +2: PRINT CHR$(64+i);". ";choice$(i)
NEXT i
PRINT
opflag=0
WHILE opflag = 0
LOCATE 5+choicenum%,linest+2
PRINT "CHOICE --> ";
LOCATE ,linest+13
chce$=""
WHILE chce$ < "A" OR chce$ > CHR$(64+choicenum%)
chce$ = INPUT$(1):chce$=UCASE$(chce$)
WEND
opt%=ASC(chce$)-64
LOCATE 3+opt%,linest+2
COLOR bgcol,olcol
PRINT chce$;". ";choice$(opt%)
COLOR olcol,bgcol
LOCATE 5+choicenum%,linest +2
PRINT "PRESS <ENTER> TO ACCEPT THIS CHOICE ";
opt$=INPUT$(1)
IF opt$ <> CHR$(13) THEN
LOCATE 3+opt%,linest+2
PRINT chce$;". ";choice$(opt%)
ELSE
opflag=1
END IF
WEND
RETURN
RAISED:
LINE (xs,ys)-(xe,ye),olcol,b
LINE (xs-4,ys-2)-(xe+4,ye+2),olcol,b
LINE (xs-2,ys-1)-(xe+2,ye+1),olcol,b
LINE (xs+3,ys+1)-(xe-3,ye-1),bgcol,b
PAINT ((xs+xe)/2,(ys+ye)/2),bgcol
RETURN